home *** CD-ROM | disk | FTP | other *** search
- /*
- * Copyright (c) 1985 Regents of the University of California.
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms are permitted
- * provided that this notice is preserved and that due credit is given
- * to the University of California at Berkeley. The name of the University
- * may not be used to endorse or promote products derived from this
- * software without specific prior written permission. This software
- * is provided ``as is'' without express or implied warranty.
- *
- * All recipients should regard themselves as participants in an ongoing
- * research project and hence should feel obligated to report their
- * experiences (good or bad) with these elementary function codes, using
- * the sendbug(8) program, to the authors.
- */
-
- #ifndef lint
- static char sccsid[] = "@(#)sinh.c 5.2 (Berkeley) 4/29/88";
- #endif /* not lint */
-
- /* SINH(X)
- * RETURN THE HYPERBOLIC SINE OF X
- * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
- * CODED IN C BY K.C. NG, 1/8/85;
- * REVISED BY K.C. NG on 2/8/85, 3/7/85, 3/24/85, 4/16/85.
- *
- * Required system supported functions :
- * copysign(x,y)
- * scalb(x,N)
- *
- * Required kernel functions:
- * expm1(x) ...return exp(x)-1
- *
- * Method :
- * 1. reduce x to non-negative by sinh(-x) = - sinh(x).
- * 2.
- *
- * expm1(x) + expm1(x)/(expm1(x)+1)
- * 0 <= x <= lnovfl : sinh(x) := --------------------------------
- * 2
- * lnovfl <= x <= lnovfl+ln2 : sinh(x) := expm1(x)/2 (avoid overflow)
- * lnovfl+ln2 < x < INF : overflow to INF
- *
- *
- * Special cases:
- * sinh(x) is x if x is +INF, -INF, or NaN.
- * only sinh(0)=0 is exact for finite argument.
- *
- * Accuracy:
- * sinh(x) returns the exact hyperbolic sine of x nearly rounded. In
- * a test run with 1,024,000 random arguments on a VAX, the maximum
- * observed error was 1.93 ulps (units in the last place).
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following constants.
- * The decimal values may be used, provided that the compiler will convert
- * from decimal to binary accurately enough to produce the hexadecimal values
- * shown.
- */
- #if defined(vax)||defined(tahoe)
- #ifdef vax
- #define _0x(A,B) 0x/**/A/**/B
- #else /* vax */
- #define _0x(A,B) 0x/**/B/**/A
- #endif /* vax */
- /* static double */
- /* mln2hi = 8.8029691931113054792E1 , Hex 2^ 7 * .B00F33C7E22BDB */
- /* mln2lo = -4.9650192275318476525E-16 , Hex 2^-50 * -.8F1B60279E582A */
- /* lnovfl = 8.8029691931113053016E1 ; Hex 2^ 7 * .B00F33C7E22BDA */
- static long mln2hix[] = { _0x(0f33,43b0), _0x(2bdb,c7e2)};
- static long mln2lox[] = { _0x(1b60,a70f), _0x(582a,279e)};
- static long lnovflx[] = { _0x(0f33,43b0), _0x(2bda,c7e2)};
- #define mln2hi (*(double*)mln2hix)
- #define mln2lo (*(double*)mln2lox)
- #define lnovfl (*(double*)lnovflx)
- #else /* defined(vax)||defined(tahoe) */
- static double
- mln2hi = 7.0978271289338397310E2 , /*Hex 2^ 10 * 1.62E42FEFA39EF */
- mln2lo = 2.3747039373786107478E-14 , /*Hex 2^-45 * 1.ABC9E3B39803F */
- lnovfl = 7.0978271289338397310E2 ; /*Hex 2^ 9 * 1.62E42FEFA39EF */
- #endif /* defined(vax)||defined(tahoe) */
-
- #if defined(vax)||defined(tahoe)
- static max = 126 ;
- #else /* defined(vax)||defined(tahoe) */
- static max = 1023 ;
- #endif /* defined(vax)||defined(tahoe) */
-
-
- double sinh(x)
- double x;
- {
- static double one=1.0, half=1.0/2.0 ;
- double expm1(), t, scalb(), copysign(), sign;
- #if !defined(vax)&&!defined(tahoe)
- if(x!=x) return(x); /* x is NaN */
- #endif /* !defined(vax)&&!defined(tahoe) */
- sign=copysign(one,x);
- x=copysign(x,one);
- if(x<lnovfl)
- {t=expm1(x); return(copysign((t+t/(one+t))*half,sign));}
-
- else if(x <= lnovfl+0.7)
- /* subtract x by ln(2^(max+1)) and return 2^max*exp(x)
- to avoid unnecessary overflow */
- return(copysign(scalb(one+expm1((x-mln2hi)-mln2lo),max),sign));
-
- else /* sinh(+-INF) = +-INF, sinh(+-big no.) overflow to +-INF */
- return( expm1(x)*sign );
- }
-